home *** CD-ROM | disk | FTP | other *** search
/ Usenet 1993 July / InfoMagic USENET CD-ROM July 1993.ISO / sources / misc / volume24 / gnucalc / part18 < prev    next >
Encoding:
Text File  |  1991-10-31  |  55.3 KB  |  1,710 lines
  1. Newsgroups: comp.sources.misc
  2. From: daveg@synaptics.com (David Gillespie)
  3. Subject:  v24i066:  gnucalc - GNU Emacs Calculator, v2.00, Part18/56
  4. Message-ID: <1991Oct31.072543.17772@sparky.imd.sterling.com>
  5. X-Md4-Signature: af147e014f18196725b5e8bb4046407b
  6. Date: Thu, 31 Oct 1991 07:25:43 GMT
  7. Approved: kent@sparky.imd.sterling.com
  8.  
  9. Submitted-by: daveg@synaptics.com (David Gillespie)
  10. Posting-number: Volume 24, Issue 66
  11. Archive-name: gnucalc/part18
  12. Environment: Emacs
  13. Supersedes: gmcalc: Volume 13, Issue 27-45
  14.  
  15. ---- Cut Here and unpack ----
  16. #!/bin/sh
  17. # this is Part.18 (part 18 of a multipart archive)
  18. # do not concatenate these parts, unpack them in order with /bin/sh
  19. # file calc-graph.el continued
  20. #
  21. if test ! -r _shar_seq_.tmp; then
  22.     echo 'Please unpack part 1 first!'
  23.     exit 1
  24. fi
  25. (read Scheck
  26.  if test "$Scheck" != 18; then
  27.     echo Please unpack part "$Scheck" next!
  28.     exit 1
  29.  else
  30.     exit 0
  31.  fi
  32. ) < _shar_seq_.tmp || exit 1
  33. if test ! -f _shar_wnt_.tmp; then
  34.     echo 'x - still skipping calc-graph.el'
  35. else
  36. echo 'x - continuing file calc-graph.el'
  37. sed 's/^X//' << 'SHAR_EOF' >> 'calc-graph.el' &&
  38. X      (or (>= calc-gnuplot-version 3)
  39. X      (insert cmd))
  40. X      (set-marker (process-mark calc-gnuplot-process) (point))
  41. X      (process-send-string calc-gnuplot-process cmd)
  42. X      (if (get-buffer-window calc-gnuplot-buffer)
  43. X      (calc-graph-view-trail))
  44. X      (accept-process-output (and (not calc-graph-no-wait)
  45. X                  calc-gnuplot-process))
  46. X      (calc-gnuplot-check-for-errors)
  47. X      (if (get-buffer-window calc-gnuplot-buffer)
  48. X      (calc-graph-view-trail))))
  49. )
  50. (setq calc-graph-no-wait nil)
  51. X
  52. (defun calc-graph-init-buffers ()
  53. X  (or (and calc-gnuplot-buffer
  54. X       (buffer-name calc-gnuplot-buffer))
  55. X      (setq calc-gnuplot-buffer (get-buffer-create "*Gnuplot Trail*")))
  56. X  (or (and calc-gnuplot-input
  57. X       (buffer-name calc-gnuplot-input))
  58. X      (setq calc-gnuplot-input (get-buffer-create "*Gnuplot Commands*")))
  59. )
  60. X
  61. (defun calc-graph-init ()
  62. X  (or (calc-gnuplot-alive)
  63. X      (let ((process-connection-type t)
  64. X        origin)
  65. X    (if calc-gnuplot-process
  66. X        (progn
  67. X          (delete-process calc-gnuplot-process)
  68. X          (setq calc-gnuplot-process nil)))
  69. X    (calc-graph-init-buffers)
  70. X    (save-excursion
  71. X      (set-buffer calc-gnuplot-buffer)
  72. X      (insert "\nStarting gnuplot...\n")
  73. X      (setq origin (point)))
  74. X    (setq calc-graph-last-device nil)
  75. X    (setq calc-graph-last-output nil)
  76. X    (condition-case err
  77. X        (let ((args (append (and calc-gnuplot-display
  78. X                     (not (equal calc-gnuplot-display
  79. X                         (getenv "DISPLAY")))
  80. X                     (list "-display"
  81. X                       calc-gnuplot-display))
  82. X                (and calc-gnuplot-geometry
  83. X                     (list "-geometry"
  84. X                       calc-gnuplot-geometry)))))
  85. X          (setq calc-gnuplot-process 
  86. X            (apply 'start-process
  87. X               "gnuplot"
  88. X               calc-gnuplot-buffer
  89. X               calc-gnuplot-name
  90. X               args))
  91. X          (process-kill-without-query calc-gnuplot-process))
  92. X      (file-error
  93. X       (error "Sorry, can't find \"%s\" on your system."
  94. X          calc-gnuplot-name)))
  95. X    (save-excursion
  96. X      (set-buffer calc-gnuplot-buffer)
  97. X      (while (and (not (save-excursion
  98. X                 (goto-char origin)
  99. X                 (search-forward "gnuplot> " nil t)))
  100. X              (memq (process-status calc-gnuplot-process) '(run stop)))
  101. X        (accept-process-output calc-gnuplot-process))
  102. X      (or (memq (process-status calc-gnuplot-process) '(run stop))
  103. X          (error "Unable to start GNUPLOT process."))
  104. X      (if (save-excursion
  105. X        (goto-char origin)
  106. X        (re-search-forward
  107. X         "G N U P L O T.*\n.*version \\([0-9]+\\)\\." nil t))
  108. X          (setq calc-gnuplot-version (string-to-int (buffer-substring
  109. X                             (match-beginning 1)
  110. X                             (match-end 1))))
  111. X        (setq calc-gnuplot-version 1))
  112. X      (goto-char (point-max)))))
  113. X  (save-excursion
  114. X    (set-buffer calc-gnuplot-input)
  115. X    (if (= (buffer-size) 0)
  116. X    (insert "# Commands for running gnuplot\n\n\n")
  117. X      (or calc-graph-no-auto-view
  118. X      (eq (char-after (1- (point-max))) ?\n)
  119. X      (progn
  120. X        (goto-char (point-max))
  121. X        (insert "\n")))))
  122. )
  123. X
  124. SHAR_EOF
  125. echo 'File calc-graph.el is complete' &&
  126. chmod 0644 calc-graph.el ||
  127. echo 'restore of calc-graph.el failed'
  128. Wc_c="`wc -c < 'calc-graph.el'`"
  129. test 47114 -eq "$Wc_c" ||
  130.     echo 'calc-graph.el: original size 47114, current size' "$Wc_c"
  131. rm -f _shar_wnt_.tmp
  132. fi
  133. # ============= calc-help.el ==============
  134. if test -f 'calc-help.el' -a X"$1" != X"-c"; then
  135.     echo 'x - skipping calc-help.el (File already exists)'
  136.     rm -f _shar_wnt_.tmp
  137. else
  138. > _shar_wnt_.tmp
  139. echo 'x - extracting calc-help.el (Text)'
  140. sed 's/^X//' << 'SHAR_EOF' > 'calc-help.el' &&
  141. ;; Calculator for GNU Emacs, part II [calc-help.el]
  142. ;; Copyright (C) 1990, 1991 Free Software Foundation, Inc.
  143. ;; Written by Dave Gillespie, daveg@csvax.cs.caltech.edu.
  144. X
  145. ;; This file is part of GNU Emacs.
  146. X
  147. ;; GNU Emacs is distributed in the hope that it will be useful,
  148. ;; but WITHOUT ANY WARRANTY.  No author or distributor
  149. ;; accepts responsibility to anyone for the consequences of using it
  150. ;; or for whether it serves any particular purpose or works at all,
  151. ;; unless he says so in writing.  Refer to the GNU Emacs General Public
  152. ;; License for full details.
  153. X
  154. ;; Everyone is granted permission to copy, modify and redistribute
  155. ;; GNU Emacs, but only under the conditions described in the
  156. ;; GNU Emacs General Public License.   A copy of this license is
  157. ;; supposed to have been given to you along with GNU Emacs so you
  158. ;; can know your rights and responsibilities.  It should be in a
  159. ;; file named COPYING.  Among other things, the copyright notice
  160. ;; and this notice must be preserved on all copies.
  161. X
  162. X
  163. X
  164. ;; This file is autoloaded from calc-ext.el.
  165. (require 'calc-ext)
  166. X
  167. (require 'calc-macs)
  168. X
  169. (defun calc-Need-calc-help () nil)
  170. X
  171. X
  172. (defun calc-help-prefix (arg)
  173. X  "This key is the prefix for Calc help functions.  See calc-help-for-help."
  174. X  (interactive "P")
  175. X  (or calc-dispatch-help (sit-for echo-keystrokes))
  176. X  (let ((key (calc-read-key-sequence
  177. X          (if calc-dispatch-help
  178. X          "Calc Help options: Help, Info, Tutorial, Summary; Key, Function; ?=more"
  179. X        (format "%s  (Type ? for a list of Calc Help options)"
  180. X            (key-description (this-command-keys))))
  181. X          calc-help-map)))
  182. X    (setq key (lookup-key calc-help-map key))
  183. X    (message "")
  184. X    (if key
  185. X    (call-interactively key)
  186. X      (beep)))
  187. )
  188. X
  189. (defun calc-help-for-help (arg)
  190. X  "You have typed `h', the Calc help character.  Type a Help option:
  191. X
  192. B  calc-describe-bindings.  Display a table of all key bindings.
  193. H  calc-full-help.  Display all `?' key messages at once.
  194. X
  195. I  calc-info.  Read the Calc manual using the Info system.
  196. T  calc-tutorial.  Read the Calc tutorial using the Info system.
  197. S  calc-info-summary.  Read the Calc summary using the Info system.
  198. X
  199. C  calc-describe-key-briefly.  Look up the command name for a given key.
  200. K  calc-describe-key.  Look up a key's documentation in the manual.
  201. F  calc-describe-function.  Look up a function's documentation in the manual.
  202. V  calc-describe-variable.  Look up a variable's documentation in the manual.
  203. X
  204. N  calc-view-news.  Display Calc history of changes.
  205. X
  206. C-c  Describe conditions for copying Calc.
  207. C-d  Describe how you can get a new copy of Calc or report a bug.
  208. C-w  Describe how there is no warranty for Calc."
  209. X  (interactive "P")
  210. X  (if calc-dispatch-help
  211. X      (let (key)
  212. X    (save-window-excursion
  213. X      (describe-function 'calc-help-for-help)
  214. X      (select-window (get-buffer-window "*Help*"))
  215. X      (while (progn
  216. X           (message "Calc Help options: Help, Info, ...  press SPC, DEL to scroll, C-g to cancel")
  217. X           (memq (setq key (read-char)) '(?  ?\C-h ?\C-? ?\C-v ?\M-v)))
  218. X        (condition-case err
  219. X        (if (memq key '(?  ?\C-v))
  220. X            (scroll-up)
  221. X          (scroll-down))
  222. X          (error (beep)))))
  223. X    (setq unread-command-char key)
  224. X    (calc-help-prefix nil))
  225. X    (let ((calc-dispatch-help t))
  226. X      (calc-help-prefix arg)))
  227. )
  228. X
  229. (defun calc-describe-copying ()
  230. X  (interactive)
  231. X  (calc-info)
  232. X  (Info-goto-node "Copying")
  233. )
  234. X
  235. (defun calc-describe-distribution ()
  236. X  (interactive)
  237. X  (calc-info)
  238. X  (Info-goto-node "Reporting Bugs")
  239. )
  240. X
  241. (defun calc-describe-no-warranty ()
  242. X  (interactive)
  243. X  (calc-info)
  244. X  (Info-goto-node "Copying")
  245. X  (let ((case-fold-search nil))
  246. X    (search-forward "     NO WARRANTY"))
  247. X  (beginning-of-line)
  248. X  (recenter 0)
  249. )
  250. X
  251. (defun calc-describe-bindings ()
  252. X  (interactive)
  253. X  (describe-bindings)
  254. X  (save-excursion
  255. X    (set-buffer "*Help*")
  256. X    (goto-char (point-min))
  257. X    (if (search-forward "Global bindings:" nil t)
  258. X    (delete-region (match-beginning 0) (point-max)))
  259. X    (goto-char (point-min))
  260. X    (while (re-search-forward "\n[a-z] ESC" nil t)
  261. X      (end-of-line)
  262. X      (delete-region (match-beginning 0) (point)))
  263. X    (goto-char (point-min))
  264. X    (while (re-search-forward "\nESC m" nil t)
  265. X      (end-of-line)
  266. X      (delete-region (match-beginning 0) (point)))
  267. X    (goto-char (point-min))
  268. X    (while (search-forward "\n\n\n" nil t)
  269. X      (backward-delete-char 1)
  270. X      (backward-char 2))
  271. X    (goto-char (point-min))
  272. X    (while
  273. X    (re-search-forward
  274. X     "\n[a-z] [0-9]\\(\t\t.*\n\\)\\([a-z] [0-9]\\1\\)*[a-z] \\([0-9]\\)\\1"
  275. X     nil t)
  276. X      (let ((dig1 (char-after (1- (match-beginning 1))))
  277. X        (dig2 (char-after (match-beginning 3))))
  278. X    (delete-region (match-end 1) (match-end 0))
  279. X    (goto-char (match-beginning 1))
  280. X    (delete-backward-char 1)
  281. X    (delete-char 1)
  282. X    (insert (format "%c .. %c" (min dig1 dig2) (max dig1 dig2)))))
  283. X    (goto-char (point-min)))
  284. )
  285. X
  286. (defun calc-describe-key-briefly (key)
  287. X  (interactive "kDescribe key briefly: ")
  288. X  (calc-describe-key key t)
  289. )
  290. X
  291. (defun calc-describe-key (key &optional briefly)
  292. X  (interactive "kDescribe key: ")
  293. X  (let ((defn (if (eq (key-binding key) 'calc-dispatch)
  294. X          (let ((key2 (calc-read-key-sequence
  295. X                   (format "Describe key briefly: %s-"
  296. X                       (key-description key))
  297. X                   calc-dispatch-map)))
  298. X            (setq key (concat key key2))
  299. X            (lookup-key calc-dispatch-map key2))
  300. X        (if (eq (key-binding key) 'calc-help-prefix)
  301. X            (let ((key2 (calc-read-key-sequence
  302. X                 (format "Describe key briefly: %s-"
  303. X                     (key-description key))
  304. X                 calc-help-map)))
  305. X              (setq key (concat key key2))
  306. X              (lookup-key calc-help-map key2))
  307. X          (key-binding key))))
  308. X    (inv nil)
  309. X    (hyp nil))
  310. X    (while (or (equal key "I") (equal key "H"))
  311. X      (if (equal key "I")
  312. X      (setq inv (not inv))
  313. X    (setq hyp (not hyp)))
  314. X      (setq key (read-key-sequence (format "Describe key%s:%s%s "
  315. X                       (if briefly " briefly" "")
  316. X                       (if inv " I" "")
  317. X                       (if hyp " H" "")))
  318. X        defn (key-binding key)))
  319. X    (let ((desc (key-description key))
  320. X      target)
  321. X      (if (string-match "^ESC " desc)
  322. X      (setq desc (concat "M-" (substring desc 4))))
  323. X      (while (string-match "^M-# \\(ESC \\|C-\\)" desc)
  324. X    (setq desc (concat "M-# " (substring desc (match-end 0)))))
  325. X      (if briefly
  326. X      (let ((msg (save-excursion
  327. X               (set-buffer (get-buffer-create "*Calc Summary*"))
  328. X               (if (= (buffer-size) 0)
  329. X               (progn
  330. X                 (message "Reading Calc summary from manual...")
  331. X                 (save-window-excursion
  332. X                   (save-excursion
  333. X                 (calc-info)
  334. X                 (Info-goto-node "Summary")
  335. X                 (goto-char (point-min))
  336. X                 (forward-line 1)
  337. X                 (copy-to-buffer "*Calc Summary*"
  338. X                         (point) (point-max))
  339. X                 (Info-last)))
  340. X                 (setq case-fold-search nil)
  341. X                 (re-search-forward "^\\(.*\\)\\[\\.\\. a b")
  342. X                 (setq calc-summary-indentation
  343. X                   (- (match-end 1) (match-beginning 1)))))
  344. X               (goto-char (point-min))
  345. X               (setq target (if (and (string-match "[0-9]\\'" desc)
  346. X                         (not (string-match "[d#]" desc)))
  347. X                    (concat (substring desc 0 -1) "0-9")
  348. X                      desc))
  349. X               (if (re-search-forward
  350. X                (format "\n%s%s%s%s[ a-zA-Z]"
  351. X                    (make-string (+ calc-summary-indentation 9)
  352. X                         ?\.)
  353. X                    (if (string-match "M-#" desc) "   "
  354. X                      (if inv
  355. X                      (if hyp "I H " "  I ")
  356. X                    (if hyp "  H " "    ")))
  357. X                    (regexp-quote target)
  358. X                    (make-string (max (- 6 (length target)) 0)
  359. X                         ?\ ))
  360. X                nil t)
  361. X               (let (pt)
  362. X                 (beginning-of-line)
  363. X                 (forward-char calc-summary-indentation)
  364. X                 (setq pt (point))
  365. X                 (end-of-line)
  366. X                 (buffer-substring pt (point)))))))
  367. X        (if msg
  368. X        (let ((args (substring msg 0 9))
  369. X              (keys (substring msg 9 19))
  370. X              (prompts (substring msg 19 38))
  371. X              (notes "")
  372. X              (cmd (substring msg 40))
  373. X              msg)
  374. X          (if (string-match "\\` +" args)
  375. X              (setq args (substring args (match-end 0))))
  376. X          (if (string-match " +\\'" args)
  377. X              (setq args (substring args 0 (match-beginning 0))))
  378. X          (if (string-match "\\` +" keys)
  379. X              (setq keys (substring keys (match-end 0))))
  380. X          (if (string-match " +\\'" keys)
  381. X              (setq keys (substring keys 0 (match-beginning 0))))
  382. X          (if (string-match " [0-9,]+\\'" prompts)
  383. X              (setq notes (substring prompts (1+ (match-beginning 0)))
  384. X                prompts (substring prompts 0 (match-beginning 0))))
  385. X          (if (string-match " +\\'" prompts)
  386. X              (setq prompts (substring prompts 0 (match-beginning 0))))
  387. X          (if (string-match "\\` +" prompts)
  388. X              (setq prompts (substring prompts (match-end 0))))
  389. X          (setq msg (format
  390. X                 "%s:  %s%s`%s'%s%s %s%s"
  391. X                 (if (string-match
  392. X                  "\\`\\(calc-[-a-zA-Z0-9]+\\) *\\(.*\\)\\'"
  393. X                  cmd)
  394. X                 (prog1 (math-match-substring cmd 1)
  395. X                   (setq cmd (math-match-substring cmd 2)))
  396. X                   defn)
  397. X                 args (if (equal args "") "" " ")
  398. X                 keys
  399. X                 (if (equal prompts "") "" " ") prompts
  400. X                 (if (equal cmd "") "" " => ") cmd))
  401. X          (message "%s%s%s runs %s%s"
  402. X               (if inv "I " "") (if hyp "H " "") desc
  403. X               msg
  404. X               (if (equal notes "") ""
  405. X                 (format "  (?=notes %s)" notes)))
  406. X          (let ((key (read-char)))
  407. X            (if (eq key ??)
  408. X            (if (equal notes "")
  409. X                (message "No notes for this command")
  410. X              (while (string-match "," notes)
  411. X                (aset notes (match-beginning 0) ? ))
  412. X              (setq notes (sort (car (read-from-string
  413. X                          (format "(%s)" notes)))
  414. X                        '<))
  415. X              (with-output-to-temp-buffer "*Help*"
  416. X                (princ (format "%s\n\n" msg))
  417. X                (set-buffer "*Calc Summary*")
  418. X                (re-search-forward "^ *NOTES")
  419. X                (while notes
  420. X                  (re-search-forward
  421. X                   (format "^ *%d\\. " (car notes)))
  422. X                  (beginning-of-line)
  423. X                  (let ((pt (point)))
  424. X                (forward-line 1)
  425. X                (or (re-search-forward "^ ? ?[0-9]+\\. " nil t)
  426. X                    (goto-char (point-max)))
  427. X                (beginning-of-line)
  428. X                (princ (buffer-substring pt (point))))
  429. X                  (setq notes (cdr notes)))
  430. X                (print-help-return-message)))
  431. X              (setq unread-command-char key))))
  432. X          (if (or (null defn) (integerp defn))
  433. X          (message "%s is undefined" desc)
  434. X        (message "%s runs the command %s"
  435. X             desc
  436. X             (if (symbolp defn) defn (prin1-to-string defn))))))
  437. X    (if inv (setq desc (concat "I " desc)))
  438. X    (if hyp (setq desc (concat "H " desc)))
  439. X    (calc-describe-thing desc "Key Index" nil
  440. X                 (> (length desc) (length key))))))
  441. )
  442. X
  443. (defun calc-describe-function (&optional func)
  444. X  (interactive)
  445. X  (or func
  446. X      (setq func (intern (completing-read "Describe function: "
  447. X                      obarray nil t "calcFunc-"))))
  448. X  (setq func (symbol-name func))
  449. X  (if (string-match "\\`calc-." func)
  450. X      (calc-describe-thing func "Command Index")
  451. X    (calc-describe-thing (if (string-match "\\`calcFunc-." func)
  452. X                 (substring func 9)
  453. X               func)
  454. X             "Function Index"))
  455. )
  456. X
  457. (defun calc-describe-variable (&optional var)
  458. X  (interactive)
  459. X  (or var
  460. X      (setq var (intern (completing-read "Describe variable: "
  461. X                     obarray nil t "var-"))))
  462. X  (setq var (symbol-name var))
  463. X  (calc-describe-thing var "Variable Index"
  464. X               (if (string-match "\\`var-." var)
  465. X               (substring var 4)
  466. X             var))
  467. )
  468. X
  469. (defun calc-describe-thing (thing where &optional target not-quoted)
  470. X  (message "Looking for `%s' in %s..." thing where)
  471. X  (let ((savewin (current-window-configuration)))
  472. X    (calc-info)
  473. X    (Info-goto-node where)
  474. X    (or (let ((case-fold-search nil))
  475. X      (re-search-forward (format "\n\\* +%s: \\(.*\\)\\."
  476. X                     (regexp-quote thing))
  477. X                 nil t))
  478. X    (and (string-match "\\`\\([a-z ]*\\)[0-9]\\'" thing)
  479. X         (re-search-forward (format "\n\\* +%s[01]-9: \\(.*\\)\\."
  480. X                    (substring thing 0 -1))
  481. X                nil t)
  482. X         (setq thing (format "%s9" (substring thing 0 -1))))
  483. X    (progn
  484. X      (Info-last)
  485. X      (set-window-configuration savewin)
  486. X      (error "Can't find `%s' in %s" thing where)))
  487. X    (let (Info-history)
  488. X      (Info-goto-node (buffer-substring (match-beginning 1) (match-end 1))))
  489. X    (or (let ((case-fold-search nil))
  490. X      (or (search-forward (format "\\[`%s'\\]\\|(`%s')\\|\\<The[ \n]`%s'"
  491. X                      (or target thing)
  492. X                      (or target thing)
  493. X                      (or target thing)) nil t)
  494. X          (and not-quoted
  495. X           (let ((case-fold-search t))
  496. X             (search-forward (or target thing) nil t)))
  497. X          (search-forward (format "`%s'" (or target thing)) nil t)
  498. X          (search-forward (or target thing) nil t)))
  499. X    (let ((case-fold-search t))
  500. X      (or (search-forward (format "\\[`%s'\\]\\|(`%s')\\|\\<The[ \n]`%s'"
  501. X                      (or target thing)
  502. X                      (or target thing)
  503. X                      (or target thing)) nil t)
  504. X          (search-forward (format "`%s'" (or target thing)) nil t)
  505. X          (search-forward (or target thing) nil t))))
  506. X    (beginning-of-line)
  507. X    (message "Found `%s' in %s" thing where))
  508. )
  509. X
  510. (defun calc-view-news ()
  511. X  (interactive)
  512. X  (let ((path load-path))
  513. X    (while (and path
  514. X        (not (file-exists-p (expand-file-name "calc.el" (car path)))))
  515. X      (setq path (cdr path)))
  516. X    (or (and path
  517. X         (file-exists-p (expand-file-name "README" (car path))))
  518. X    (error "Can't locate Calc sources"))
  519. X    (calc-quit)
  520. X    (switch-to-buffer "*Help*")
  521. X    (erase-buffer)
  522. X    (insert-file-contents (expand-file-name "README" (car path)))
  523. X    (search-forward "Summary of changes")
  524. X    (forward-line -1)
  525. X    (delete-region (point-min) (point))
  526. X    (goto-char (point-min)))
  527. )
  528. X
  529. X
  530. X
  531. (defun calc-full-help ()
  532. X  (interactive)
  533. X  (with-output-to-temp-buffer "*Help*"
  534. X    (princ (format "GNU Emacs Calculator version %s of %s.\n"
  535. X           calc-version calc-version-date))
  536. X    (princ "  By Dave Gillespie, daveg@csvax.cs.caltech.edu")
  537. X    (princ " / daveg@synaptics.com.\n")
  538. X    (princ (format "  Installed %s.\n" calc-installed-date))
  539. X    (princ "  Copyright (C) 1990, 1991 Free Software Foundation, Inc.\n\n")
  540. X    (princ "Type `h s' for a more detailed summary.\n")
  541. X    (princ "Or type `h i' to read the full Calc manual on-line.\n\n")
  542. X    (princ "Basic keys:\n")
  543. X    (let* ((calc-full-help-flag t))
  544. X      (mapcar (function (lambda (x) (princ (format "  %s\n" x))))
  545. X          (nreverse (cdr (reverse (cdr (calc-help))))))
  546. X      (mapcar (function (lambda (prefix)
  547. X              (let ((msgs (funcall prefix)))
  548. X                (if (car msgs)
  549. X                (princ
  550. X                 (if (eq (nth 2 msgs) ?v)
  551. X                     "\n`v' or `V' prefix (vector/matrix) keys: \n"
  552. X                   (if (nth 2 msgs)
  553. X                       (format
  554. X                    "\n`%c' prefix (%s) keys:\n"
  555. X                    (nth 2 msgs)
  556. X                    (or (cdr (assq (nth 2 msgs)
  557. X                               calc-help-long-names))
  558. X                        (nth 1 msgs)))
  559. X                     (format "\n%s-modified keys:\n"
  560. X                         (capitalize (nth 1 msgs)))))))
  561. X                (mapcar (function (lambda (x)
  562. X                        (princ (format "  %s\n" x))))
  563. X                    (car msgs)))))
  564. X          '(calc-inverse-prefix-help
  565. X        calc-hyperbolic-prefix-help
  566. X        calc-inv-hyp-prefix-help
  567. X        calc-a-prefix-help
  568. X        calc-b-prefix-help
  569. X        calc-c-prefix-help
  570. X        calc-d-prefix-help
  571. X        calc-f-prefix-help
  572. X        calc-g-prefix-help
  573. X        calc-h-prefix-help
  574. X        calc-j-prefix-help
  575. X        calc-k-prefix-help
  576. X        calc-m-prefix-help
  577. X        calc-r-prefix-help
  578. X        calc-s-prefix-help
  579. X        calc-t-prefix-help
  580. X        calc-u-prefix-help
  581. X        calc-v-prefix-help
  582. X        calc-shift-Y-prefix-help
  583. X        calc-shift-Z-prefix-help
  584. X        calc-z-prefix-help)))
  585. X    (print-help-return-message))
  586. )
  587. X
  588. (defvar calc-help-long-names '( ( ?b . "binary/business" )
  589. X                ( ?g . "graphics" )
  590. X                ( ?j . "selection" )
  591. X                ( ?k . "combinatorics/statistics" )
  592. X                ( ?u . "units/statistics" )
  593. ))
  594. X
  595. (defun calc-h-prefix-help ()
  596. X  (interactive)
  597. X  (calc-do-prefix-help
  598. X   '("Help; Bindings; Info, Tutorial, Summary; News"
  599. X     "describe: Key, C (briefly), Function, Variable")
  600. X   "help" ?h)
  601. )
  602. X
  603. (defun calc-inverse-prefix-help ()
  604. X  (interactive)
  605. X  (calc-do-prefix-help
  606. X   '("I + S (arcsin), C (arccos), T (arctan); Q (square)"
  607. X     "I + E (ln), L (exp), B (alog: B^X); f E (lnp1), f L (expm1)"
  608. X     "I + F (ceiling), R (truncate); a S (invert func)"
  609. X     "I + a m (match-not); c h (from-hms); k n (prev prime)"
  610. X     "I + f G (gamma-Q); f e (erfc); k B (etc., lower-tail dists)"
  611. X     "I + V S (reverse sort); V G (reverse grade)"
  612. X     "I + v s (remove subvec); v h (tail)"
  613. X     "I + t + (alt sum), t M (mean with error)"
  614. X     "I + t S (pop std dev), t C (pop covar)")
  615. X   "inverse" nil)
  616. )
  617. X
  618. (defun calc-hyperbolic-prefix-help ()
  619. X  (interactive)
  620. X  (calc-do-prefix-help
  621. X   '("H + S (sinh), C (cosh), T (tanh); E (exp10), L (log10)"
  622. X     "H + F (float floor), R (float round); P (constant \"e\")"
  623. X     "H + a d (total derivative); k c (permutations)"
  624. X     "H + k b (bern-poly), k e (euler-poly); k s (stirling-2)"
  625. X     "H + f G (gamma-g), f B (beta-B); v h (rhead), v k (rcons)"
  626. X     "H + v e (expand w/filler); V H (weighted histogram)"
  627. X     "H + a S (general solve eqn), j I (general isolate)"
  628. X     "H + a R (widen/root), a N (widen/min), a X (widen/max)"
  629. X     "H + t M (median), t S (variance), t C (correlation coef)"
  630. X     "H + c f/F/c (pervasive float/frac/clean)")
  631. X   "hyperbolic" nil)
  632. )
  633. X
  634. (defun calc-inv-hyp-prefix-help ()
  635. X  (interactive)
  636. X  (calc-do-prefix-help
  637. X   '("I H + S (arcsinh), C (arccosh), T (arctanh)"
  638. X     "I H + E (log10), L (exp10); f G (gamma-G)"
  639. X     "I H + F (float ceiling), R (float truncate)"
  640. X     "I H + t S (pop variance)"
  641. X     "I H + a S (general invert func); v h (rtail)")
  642. X   "inverse-hyperbolic" nil)
  643. )
  644. X
  645. X
  646. (defun calc-f-prefix-help ()
  647. X  (interactive)
  648. X  (calc-do-prefix-help
  649. X   '("miN, maX; Hypot; Im, Re; Sign; [, ] (incr/decr)"
  650. X     "Gamma, Beta, Erf, besselJ, besselY"
  651. X     "SHIFT + int-sQrt; Int-log, Exp(x)-1, Ln(x+1); arcTan2"
  652. X     "SHIFT + Abssqr; Mantissa, eXponent, Scale"
  653. X     "SHIFT + incomplete: Gamma-P, Beta-I")
  654. X   "functions" ?f)
  655. )
  656. X
  657. X
  658. (defun calc-s-prefix-help ()
  659. X  (interactive)
  660. X  (calc-do-prefix-help
  661. X   '("Store, inTo, Xchg, Unstore; Recall, 0-9; : (:=); = (=>)"
  662. X     "Let; Copy; Declare; Insert, Perm; Edit"
  663. X     "Negate, +, -, *, /, ^, &, |, [, ]; Map"
  664. X     "SHIFT + Decls, GenCount, TimeZone"
  665. X     "SHIFT + LineStyles, PointStyles, plotRejects"
  666. X     "SHIFT + Eval-, AlgSimp-, ExtSimp-, UnitSimp-, FitRules")
  667. X   "store" ?s)
  668. )
  669. X
  670. (defun calc-r-prefix-help ()
  671. X  (interactive)
  672. X  (calc-do-prefix-help
  673. X   '("digits 0-9: recall, same as `s r 0-9'")
  674. X   "recall" ?r)
  675. )
  676. X
  677. X
  678. (defun calc-j-prefix-help ()
  679. X  (interactive)
  680. X  (calc-do-prefix-help
  681. X   '("Select, Additional, Once; eVal, Formula; Rewrite"
  682. X     "More, Less, 1-9, Next, Previous"
  683. X     "Unselect, Clear; Display; Enable; Breakable"
  684. X     "' (replace), ` (edit), +, -, *, /, RET (grab), DEL"
  685. X     "SHIFT + swap: Left, Right; maybe: Select, Once"
  686. X     "SHIFT + Commute, Merge, Distrib, jump-Eqn, Isolate"
  687. X     "SHIFT + Negate, & (invert); Unpack")
  688. X   "select" ?j)
  689. )
  690. X
  691. X
  692. (defun calc-a-prefix-help ()
  693. X  (interactive)
  694. X  (calc-do-prefix-help
  695. X   '("Simplify, Extended-simplify, eVal; \" (exp-formula)"
  696. X     "eXpand, Collect, Factor, Apart, Norm-rat"
  697. X     "GCD, /, \\, % (polys); Polint"
  698. X     "Derivative, Integral, Taylor; _ (subscr)"
  699. X     "suBstitute; Rewrite, Match"
  700. X     "SHIFT + Solve; Root, miN, maX; Poly-roots; Fit"
  701. X     "SHIFT + Map; Tabulate, + (sum), * (prod); num-Integ"
  702. X     "relations: =, # (not =), <, >, [ (< or =), ] (> or =)"
  703. X     "logical: & (and), | (or), ! (not); : (if)"
  704. X     "misc: { (in-set); . (rmeq)")
  705. X   "algebra" ?a)
  706. )
  707. X
  708. X
  709. (defun calc-b-prefix-help ()
  710. X  (interactive)
  711. X  (calc-do-prefix-help
  712. X   '("And, Or, Xor, Diff, Not; Wordsize, Clip"
  713. X     "Lshift, Rshift, roTate; SHIFT + signed Lshift, Rshift"
  714. X     "SHIFT + business: Pv, Npv, Fv, pMt, #pmts, raTe, Irr"
  715. X     "SHIFT + business: Sln, sYd, Ddb")
  716. X   "binary/bus" ?b)
  717. )
  718. X
  719. X
  720. (defun calc-c-prefix-help ()
  721. X  (interactive)
  722. X  (calc-do-prefix-help
  723. X   '("Deg, Rad, HMS; Float; Polar/rect; Clean, 0-9"
  724. X     "SHIFT + Fraction")
  725. X   "convert" ?c)
  726. )
  727. X
  728. X
  729. (defun calc-d-prefix-help ()
  730. X  (interactive)
  731. X  (calc-do-prefix-help
  732. X   '("Group, \",\"; Normal, Fix, Sci, Eng, \".\"; Over"
  733. X     "Radix, Zeros, 2, 8, 0, 6; Hms; Date; Complex, I, J"
  734. X     "Why; Line-nums, line-Breaks; <, =, > (justify); Plain"
  735. X     "\" (strings); Truncate, [, ]; ` (align); SPC (refresh)"
  736. X     "SHIFT + language: Normal, One-line, Big, Unformatted"
  737. X     "SHIFT + language: C, Pascal, Fortran; TeX, Eqn"
  738. X     "SHIFT + language: Mathematica, W=Maple")
  739. X   "display" ?d)
  740. )
  741. X
  742. X
  743. (defun calc-g-prefix-help ()
  744. X  (interactive)
  745. X  (calc-do-prefix-help
  746. X   '("Fast; Add, Delete, Juggle; Plot, Clear; Quit"
  747. X     "Header, Name, Grid, Border, Key; View-commands, X-display"
  748. X     "x-axis: Range, Title, Log, Zero; lineStyle"
  749. X     "SHIFT + y-axis: Range, Title, Log, Zero; pointStyle"
  750. X     "SHIFT + Print; Device, Output-file; X-geometry"
  751. X     "SHIFT + Num-pts; Command, Kill, View-trail"
  752. X     "SHIFT + 3d: Fast, Add; CTRL + z-axis: Range, Title, Log")
  753. X   "graph" ?g)
  754. )
  755. X
  756. X
  757. (defun calc-k-prefix-help ()
  758. X  (interactive)
  759. X  (calc-do-prefix-help
  760. X   '("GCD, LCM; Choose (binomial), Double-factorial"
  761. X     "Random, random-Again, sHuffle"
  762. X     "Factors, Prime-test, Next-prime, Totient, Moebius"
  763. X     "Bernoulli, Euler, Stirling"
  764. X     "SHIFT + Extended-gcd"
  765. X     "SHIFT + dists: Binomial, Chi-square, F, Normal"
  766. X     "SHIFT + dists: Poisson, student's-T")
  767. X   "combinatorics" ?k)
  768. )
  769. X
  770. X
  771. (defun calc-m-prefix-help ()
  772. X  (interactive)
  773. X  (calc-do-prefix-help
  774. X   '("Deg, Rad, HMS; Frac; Polar; Inf; Alg, Total; Symb; Vec/mat"
  775. X     "Working; Xtensions; Mode-save"
  776. X     "SHIFT + Shifted-prefixes, mode-Filename; Record; reCompute"
  777. X     "SHIFT + simplify: Off, Num, Default, Bin, Alg, Ext, Units")
  778. X   "mode" ?m)
  779. )
  780. X
  781. X
  782. (defun calc-t-prefix-help ()
  783. X  (interactive)
  784. X  (calc-do-prefix-help
  785. X   '("Display; Fwd, Back; Next, Prev, Here, [, ]; Yank"
  786. X     "Search, Rev; In, Out; <, >; Kill; Marker; . (abbrev)"
  787. X     "SHIFT + time: Now; Part; Date, Julian, Unix, Czone"
  788. X     "SHIFT + time: newWeek, newMonth, newYear; Incmonth"
  789. X     "digits 0-9: store-to, same as `s t 0-9'")
  790. X   "trail/time" ?t)
  791. )
  792. X
  793. X
  794. (defun calc-u-prefix-help ()
  795. X  (interactive)
  796. X  (calc-do-prefix-help
  797. X   '("Simplify, Convert, Temperature-convert, Base-units"
  798. X     "Autorange; Remove, eXtract; Explain; View-table"
  799. X     "Define, Undefine, Get-defn, Permanent"
  800. X     "SHIFT + View-table-other-window"
  801. X     "SHIFT + stat: Mean, G-mean, Std-dev, Covar, maX, miN"
  802. X     "SHIFT + stat: + (sum), - (asum), * (prod), # (count)")
  803. X   "units/stat" ?u)
  804. )
  805. X
  806. X
  807. (defun calc-v-prefix-help ()
  808. X  (interactive)
  809. X  (calc-do-prefix-help
  810. X   '("Pack, Unpack, Identity, Diagonal, indeX, Build"
  811. X     "Row, Column, Subvector; Length; Find; Mask, Expand"
  812. X     "Tranpose, Arrange, reVerse; Head, Kons; rNorm"
  813. X     "SHIFT + Det, & (inverse), LUD, Trace, conJtrn, Cross"
  814. X     "SHIFT + Sort, Grade, Histogram; cNorm"
  815. X     "SHIFT + Apply, Map, Reduce, accUm, Inner-, Outer-prod"
  816. X     "SHIFT + sets: V (union), ^ (intersection), - (diff)"
  817. X     "SHIFT + sets: Xor, ~ (complement), Floor, Enum"
  818. X     "SHIFT + sets: : (span), # (card), + (rdup)"
  819. X     "<, =, > (justification); , (commas); [, {, ( (brackets)"
  820. X     "} (matrix brackets); . (abbreviate); / (multi-lines)")
  821. X   "vec/mat" ?v)
  822. )
  823. X
  824. SHAR_EOF
  825. chmod 0644 calc-help.el ||
  826. echo 'restore of calc-help.el failed'
  827. Wc_c="`wc -c < 'calc-help.el'`"
  828. test 22452 -eq "$Wc_c" ||
  829.     echo 'calc-help.el: original size 22452, current size' "$Wc_c"
  830. rm -f _shar_wnt_.tmp
  831. fi
  832. # ============= calc-incom.el ==============
  833. if test -f 'calc-incom.el' -a X"$1" != X"-c"; then
  834.     echo 'x - skipping calc-incom.el (File already exists)'
  835.     rm -f _shar_wnt_.tmp
  836. else
  837. > _shar_wnt_.tmp
  838. echo 'x - extracting calc-incom.el (Text)'
  839. sed 's/^X//' << 'SHAR_EOF' > 'calc-incom.el' &&
  840. ;; Calculator for GNU Emacs, part II [calc-incom.el]
  841. ;; Copyright (C) 1990, 1991 Free Software Foundation, Inc.
  842. ;; Written by Dave Gillespie, daveg@csvax.cs.caltech.edu.
  843. X
  844. ;; This file is part of GNU Emacs.
  845. X
  846. ;; GNU Emacs is distributed in the hope that it will be useful,
  847. ;; but WITHOUT ANY WARRANTY.  No author or distributor
  848. ;; accepts responsibility to anyone for the consequences of using it
  849. ;; or for whether it serves any particular purpose or works at all,
  850. ;; unless he says so in writing.  Refer to the GNU Emacs General Public
  851. ;; License for full details.
  852. X
  853. ;; Everyone is granted permission to copy, modify and redistribute
  854. ;; GNU Emacs, but only under the conditions described in the
  855. ;; GNU Emacs General Public License.   A copy of this license is
  856. ;; supposed to have been given to you along with GNU Emacs so you
  857. ;; can know your rights and responsibilities.  It should be in a
  858. ;; file named COPYING.  Among other things, the copyright notice
  859. ;; and this notice must be preserved on all copies.
  860. X
  861. X
  862. X
  863. ;; This file is autoloaded from calc-ext.el.
  864. (require 'calc-ext)
  865. X
  866. (require 'calc-macs)
  867. X
  868. (defun calc-Need-calc-incom () nil)
  869. X
  870. X
  871. ;;; Incomplete forms.
  872. X
  873. (defun calc-begin-complex ()
  874. X  (interactive)
  875. X  (calc-wrapper
  876. X   (if (or calc-algebraic-mode calc-incomplete-algebraic-mode)
  877. X       (calc-alg-entry "(")
  878. X     (calc-push (list 'incomplete calc-complex-mode))))
  879. )
  880. X
  881. (defun calc-end-complex ()
  882. X  (interactive)
  883. X  (calc-comma t)
  884. X  (calc-wrapper
  885. X   (let ((top (calc-top 1)))
  886. X     (if (and (eq (car-safe top) 'incomplete)
  887. X          (eq (nth 1 top) 'intv))
  888. X     (progn
  889. X       (if (< (length top) 4)
  890. X           (setq top (append top '((neg (var inf var-inf))))))
  891. X       (if (< (length top) 5)
  892. X           (setq top (append top '((var inf var-inf)))))
  893. X       (calc-enter-result 1 "..)" (cdr top)))
  894. X       (if (not (and (eq (car-safe top) 'incomplete)
  895. X             (memq (nth 1 top) '(cplx polar))))
  896. X       (error "Not entering a complex number"))
  897. X       (while (< (length top) 4)
  898. X     (setq top (append top '(0))))
  899. X       (if (not (and (math-realp (nth 2 top))
  900. X             (math-anglep (nth 3 top))))
  901. X       (error "Components must be real"))
  902. X       (calc-enter-result 1 "()" (cdr top)))))
  903. )
  904. X
  905. (defun calc-begin-vector ()
  906. X  (interactive)
  907. X  (calc-wrapper
  908. X   (if (or calc-algebraic-mode calc-incomplete-algebraic-mode)
  909. X       (calc-alg-entry "[")
  910. X     (calc-push '(incomplete vec))))
  911. )
  912. X
  913. (defun calc-end-vector ()
  914. X  (interactive)
  915. X  (calc-comma t)
  916. X  (calc-wrapper
  917. X   (let ((top (calc-top 1)))
  918. X     (if (and (eq (car-safe top) 'incomplete)
  919. X          (eq (nth 1 top) 'intv))
  920. X     (progn
  921. X       (if (< (length top) 4)
  922. X           (setq top (append top '((neg (var inf var-inf))))))
  923. X       (if (< (length top) 5)
  924. X           (setq top (append top '((var inf var-inf)))))
  925. X       (setcar (cdr (cdr top)) (1+ (nth 2 top)))
  926. X       (calc-enter-result 1 "..]" (cdr top)))
  927. X       (if (not (and (eq (car-safe top) 'incomplete)
  928. X             (eq (nth 1 top) 'vec)))
  929. X       (error "Not entering a vector"))
  930. X       (calc-pop-push-record 1 "[]" (cdr top)))))
  931. )
  932. X
  933. (defun calc-comma (&optional allow-polar)
  934. X  (interactive)
  935. X  (calc-wrapper
  936. X   (let ((num (calc-find-first-incomplete
  937. X           (nthcdr calc-stack-top calc-stack) 1)))
  938. X     (if (= num 0)
  939. X     (error "Not entering a vector or complex number"))
  940. X     (let* ((inc (calc-top num))
  941. X        (stuff (calc-top-list (1- num)))
  942. X        (new (append inc stuff)))
  943. X       (if (and (null stuff)
  944. X        (not allow-polar)
  945. X        (or (eq (nth 1 inc) 'vec)
  946. X            (< (length new) 4)))
  947. X       (setq new (append new
  948. X                 (if (= (length new) 2)
  949. X                 '(0)
  950. X                   (nthcdr (1- (length new)) new)))))
  951. X       (or allow-polar
  952. X       (if (eq (nth 1 new) 'polar)
  953. X           (setq new (append '(incomplete cplx) (cdr (cdr new))))
  954. X         (if (eq (nth 1 new) 'intv)
  955. X         (setq new (append '(incomplete cplx)
  956. X                   (cdr (cdr (cdr new))))))))
  957. X       (if (and (memq (nth 1 new) '(cplx polar))
  958. X        (> (length new) 4))
  959. X       (error "Too many components in complex number"))
  960. X       (if (and (eq (nth 1 new) 'intv)
  961. X        (> (length new) 5))
  962. X       (error "Too many components in interval form"))
  963. X       (calc-pop-push num new))))
  964. )
  965. X
  966. (defun calc-semi ()
  967. X  (interactive)
  968. X  (calc-wrapper
  969. X   (let ((num (calc-find-first-incomplete
  970. X           (nthcdr calc-stack-top calc-stack) 1)))
  971. X     (if (= num 0)
  972. X     (error "Not entering a vector or complex number"))
  973. X     (let ((inc (calc-top num))
  974. X       (stuff (calc-top-list (1- num))))
  975. X       (if (eq (nth 1 inc) 'cplx)
  976. X       (setq inc (append '(incomplete polar) (cdr (cdr inc))))
  977. X     (if (eq (nth 1 inc) 'intv)
  978. X         (setq inc (append '(incomplete polar) (cdr (cdr (cdr inc)))))))
  979. X       (cond ((eq (nth 1 inc) 'polar)
  980. X          (let ((new (append inc stuff)))
  981. X        (if (> (length new) 4)
  982. X            (error "Too many components in complex number")
  983. X          (if (= (length new) 2)
  984. X              (setq new (append new '(1)))))
  985. X        (calc-pop-push num new)))
  986. X         ((null stuff)
  987. X          (if (> (length inc) 2)
  988. X          (if (math-vectorp (nth 2 inc))
  989. X              (calc-comma)
  990. X            (calc-pop-push 1
  991. X                   (list 'incomplete 'vec (cdr (cdr inc)))
  992. X                   (list 'incomplete 'vec)))))
  993. X         ((math-vectorp (car stuff))
  994. X          (calc-comma))
  995. X         ((eq (car-safe (car-safe (nth (+ num calc-stack-top)
  996. X                       calc-stack))) 'incomplete)
  997. X          (calc-end-vector)
  998. X          (calc-comma)
  999. X          (let ((calc-algebraic-mode nil)
  1000. X            (calc-incomplete-algebraic-mode nil))
  1001. X        (calc-begin-vector)))
  1002. X         ((or (= (length inc) 2)
  1003. X          (math-vectorp (nth 2 inc)))
  1004. X          (calc-pop-push num
  1005. X                 (append inc (list (cons 'vec stuff)))
  1006. X                 (list 'incomplete 'vec)))
  1007. X         (t
  1008. X          (calc-pop-push num
  1009. X                 (list 'incomplete 'vec
  1010. X                   (cons 'vec (append (cdr (cdr inc)) stuff)))
  1011. X                 (list 'incomplete 'vec)))))))
  1012. )
  1013. X
  1014. (defun calc-digit-dots ()
  1015. X  (if (eq calc-prev-char ?.)
  1016. X      (progn
  1017. X    (delete-backward-char 1)
  1018. X    (if (calc-minibuffer-contains ".*\\.\\'")
  1019. X        (delete-backward-char 1))
  1020. X    (setq calc-prev-char 'dots
  1021. X          last-command-char 32)
  1022. X    (if calc-prev-prev-char
  1023. X        (calcDigit-nondigit)
  1024. X      (setq calc-digit-value nil)
  1025. X      (erase-buffer)
  1026. X      (exit-minibuffer)))
  1027. X    ;; just ignore extra decimal point, anticipating ".."
  1028. X    (delete-backward-char 1))
  1029. )
  1030. X
  1031. (defun calc-dots ()
  1032. X  (interactive)
  1033. X  (calc-wrapper
  1034. X   (let ((num (calc-find-first-incomplete
  1035. X           (nthcdr calc-stack-top calc-stack) 1)))
  1036. X     (if (= num 0)
  1037. X     (error "Not entering an interval form"))
  1038. X     (let* ((inc (calc-top num))
  1039. X        (stuff (calc-top-list (1- num)))
  1040. X        (new (append inc stuff)))
  1041. X       (if (not (eq (nth 1 new) 'intv))
  1042. X       (setq new (append '(incomplete intv)
  1043. X                 (if (eq (nth 1 new) 'vec) '(2) '(0))
  1044. X                 (cdr (cdr new)))))
  1045. X       (if (and (null stuff)
  1046. X        (= (length new) 3))
  1047. X       (setq new (append new '((neg (var inf var-inf))))))
  1048. X       (if (> (length new) 5)
  1049. X       (error "Too many components in interval form"))
  1050. X       (calc-pop-push num new))))
  1051. )
  1052. X
  1053. (defun calc-find-first-incomplete (stack n)
  1054. X  (cond ((null stack)
  1055. X     0)
  1056. X    ((eq (car-safe (car-safe (car stack))) 'incomplete)
  1057. X     n)
  1058. X    (t
  1059. X     (calc-find-first-incomplete (cdr stack) (1+ n))))
  1060. )
  1061. X
  1062. (defun calc-incomplete-error (a)
  1063. X  (cond ((memq (nth 1 a) '(cplx polar))
  1064. X     (error "Complex number is incomplete"))
  1065. X    ((eq (nth 1 a) 'vec)
  1066. X     (error "Vector is incomplete"))
  1067. X    ((eq (nth 1 a) 'intv)
  1068. X     (error "Interval form is incomplete"))
  1069. X    (t (error "Object is incomplete")))
  1070. )
  1071. X
  1072. X
  1073. X
  1074. SHAR_EOF
  1075. chmod 0644 calc-incom.el ||
  1076. echo 'restore of calc-incom.el failed'
  1077. Wc_c="`wc -c < 'calc-incom.el'`"
  1078. test 7165 -eq "$Wc_c" ||
  1079.     echo 'calc-incom.el: original size 7165, current size' "$Wc_c"
  1080. rm -f _shar_wnt_.tmp
  1081. fi
  1082. # ============= calc-keypd.el ==============
  1083. if test -f 'calc-keypd.el' -a X"$1" != X"-c"; then
  1084.     echo 'x - skipping calc-keypd.el (File already exists)'
  1085.     rm -f _shar_wnt_.tmp
  1086. else
  1087. > _shar_wnt_.tmp
  1088. echo 'x - extracting calc-keypd.el (Text)'
  1089. sed 's/^X//' << 'SHAR_EOF' > 'calc-keypd.el' &&
  1090. ;; Calculator for GNU Emacs, part II [calc-keypd.el]
  1091. ;; Copyright (C) 1990, 1991 Free Software Foundation, Inc.
  1092. ;; Written by Dave Gillespie, daveg@csvax.cs.caltech.edu.
  1093. X
  1094. ;; This file is part of GNU Emacs.
  1095. X
  1096. ;; GNU Emacs is distributed in the hope that it will be useful,
  1097. ;; but WITHOUT ANY WARRANTY.  No author or distributor
  1098. ;; accepts responsibility to anyone for the consequences of using it
  1099. ;; or for whether it serves any particular purpose or works at all,
  1100. ;; unless he says so in writing.  Refer to the GNU Emacs General Public
  1101. ;; License for full details.
  1102. X
  1103. ;; Everyone is granted permission to copy, modify and redistribute
  1104. ;; GNU Emacs, but only under the conditions described in the
  1105. ;; GNU Emacs General Public License.   A copy of this license is
  1106. ;; supposed to have been given to you along with GNU Emacs so you
  1107. ;; can know your rights and responsibilities.  It should be in a
  1108. ;; file named COPYING.  Among other things, the copyright notice
  1109. ;; and this notice must be preserved on all copies.
  1110. X
  1111. X
  1112. X
  1113. ;; This file is autoloaded from calc-ext.el.
  1114. (require 'calc-ext)
  1115. X
  1116. (require 'calc-macs)
  1117. X
  1118. (defun calc-Need-calc-keypd () nil)
  1119. X
  1120. X
  1121. X
  1122. ;;; Pictorial interface to Calc using the X window system mouse.
  1123. X
  1124. (defvar calc-keypad-buffer nil)
  1125. (defvar calc-keypad-menu 0)
  1126. (defvar calc-keypad-full-layout nil)
  1127. (defvar calc-keypad-input nil)
  1128. (defvar calc-keypad-prev-input nil)
  1129. (defvar calc-keypad-prev-x-left-click nil)
  1130. (defvar calc-keypad-prev-x-middle-click nil)
  1131. (defvar calc-keypad-prev-x-right-click nil)
  1132. (defvar calc-keypad-said-hello nil)
  1133. X
  1134. (defvar calc-keypad-map nil)
  1135. (if calc-keypad-map
  1136. X    ()
  1137. X  (setq calc-keypad-map (make-sparse-keymap))
  1138. X  (define-key calc-keypad-map " " 'calc-keypad-press)
  1139. X  (define-key calc-keypad-map "\r" 'calc-keypad-press)
  1140. X  (define-key calc-keypad-map "\t" 'calc-keypad-menu)
  1141. X  (define-key calc-keypad-map "q" 'calc-keypad-off))
  1142. X
  1143. (defun calc-do-keypad (&optional full-display interactive)
  1144. X  (calc-create-buffer)
  1145. X  (let ((calcbuf (current-buffer)))
  1146. X    (or (and calc-keypad-buffer
  1147. X         (buffer-name calc-keypad-buffer))
  1148. X    (progn
  1149. X      (setq calc-keypad-buffer (get-buffer-create "*Calc Keypad*"))
  1150. X      (set-buffer calc-keypad-buffer)
  1151. X      (use-local-map calc-keypad-map)
  1152. X      (setq major-mode 'calc-keypad)
  1153. X      (setq mode-name "Calculator")
  1154. X      (put 'calc-keypad 'mode-class 'special)
  1155. X      (make-local-variable 'calc-main-buffer)
  1156. X      (setq calc-main-buffer calcbuf)
  1157. X      (calc-keypad-redraw)))
  1158. X    (let ((width 29)
  1159. X      (height 17)
  1160. X      win old-win)
  1161. X      (if (setq win (get-buffer-window "*Calculator*"))
  1162. X      (delete-window win))
  1163. X      (if (setq win (get-buffer-window "*Calc Trail*"))
  1164. X      (if (one-window-p)
  1165. X          (switch-to-buffer (other-buffer))
  1166. X        (delete-window win)))
  1167. X      (if (setq win (get-buffer-window calc-keypad-buffer))
  1168. X      (progn
  1169. X        (bury-buffer "*Calculator*")
  1170. X        (bury-buffer "*Calc Trail*")
  1171. X        (bury-buffer calc-keypad-buffer)
  1172. X        (if (one-window-p)
  1173. X        (switch-to-buffer (other-buffer))
  1174. X          (delete-window win))
  1175. X        (if (and calc-keypad-prev-x-left-click
  1176. X             (eq (aref mouse-map 0) 'calc-keypad-x-right-click)
  1177. X             (eq (aref mouse-map 1) 'calc-keypad-x-middle-click)
  1178. X             (eq (aref mouse-map 2) 'calc-keypad-x-left-click))
  1179. X        (progn
  1180. X          (aset mouse-map 0 calc-keypad-prev-x-right-click)
  1181. X          (aset mouse-map 1 calc-keypad-prev-x-middle-click)
  1182. X          (aset mouse-map 2 calc-keypad-prev-x-left-click)
  1183. X          (setq calc-keypad-prev-x-left-click nil))))
  1184. X    (setq calc-was-keypad-mode t
  1185. X          old-win (get-largest-window))
  1186. X    (if (or (< (window-height old-win) (+ height 6))
  1187. X        (< (window-width old-win) (+ width 15))
  1188. X        full-display)
  1189. X        (delete-other-windows old-win))
  1190. X    (if (< (window-height old-win) (+ height 4))
  1191. X        (error "Screen is not tall enough for this mode"))
  1192. X    (if full-display
  1193. X        (progn
  1194. X          (setq win (split-window old-win (- (window-height old-win)
  1195. X                         height 1)))
  1196. X          (set-window-buffer old-win (calc-trail-buffer))
  1197. X          (set-window-buffer win calc-keypad-buffer)
  1198. X          (set-window-start win 1)
  1199. X          (setq win (split-window win (+ width 3) t))
  1200. X          (set-window-buffer win calcbuf))
  1201. X      (if (or t  ; left-side keypad not yet fully implemented
  1202. X          (< (save-excursion
  1203. X               (set-buffer (window-buffer old-win))
  1204. X               (current-column))
  1205. X             (/ (window-width) 2)))
  1206. X          (setq win (split-window old-win (- (window-width old-win)
  1207. X                         width 2)
  1208. X                      t))
  1209. X        (setq old-win (split-window old-win (+ width 2) t)))
  1210. X      (set-window-buffer win calc-keypad-buffer)
  1211. X      (set-window-start win 1)
  1212. X      (split-window win (- (window-height win) height 1))
  1213. X      (set-window-buffer win calcbuf))
  1214. X    (select-window old-win)
  1215. X    (if (and (eq window-system 'x)
  1216. X         (not calc-keypad-prev-x-left-click))
  1217. X        (progn
  1218. X          (setq calc-keypad-prev-x-right-click (aref mouse-map 0)
  1219. X            calc-keypad-prev-x-middle-click (aref mouse-map 1)
  1220. X            calc-keypad-prev-x-left-click (aref mouse-map 2))
  1221. X          (aset mouse-map 0 'calc-keypad-x-right-click)
  1222. X          (aset mouse-map 1 'calc-keypad-x-middle-click)
  1223. X          (aset mouse-map 2 'calc-keypad-x-left-click)))
  1224. X    (message "Welcome to GNU Emacs Calc!  Use the left and right mouse buttons.")
  1225. X    (run-hooks 'calc-keypad-start-hook)
  1226. X    (and calc-keypad-said-hello interactive
  1227. X         (progn
  1228. X           (sit-for 2)
  1229. X           (message "")))
  1230. X    (setq calc-keypad-said-hello t))))
  1231. X  (setq calc-keypad-input nil)
  1232. )
  1233. X
  1234. (defun calc-keypad-off ()
  1235. X  (interactive)
  1236. X  (if calc-standalone-flag
  1237. X      (save-buffers-kill-emacs nil)
  1238. X    (calc-keypad))
  1239. )
  1240. X
  1241. (defun calc-keypad-redraw ()
  1242. X  (set-buffer calc-keypad-buffer)
  1243. X  (setq buffer-read-only t)
  1244. X  (setq calc-keypad-full-layout (append (symbol-value (nth calc-keypad-menu
  1245. X                               calc-keypad-menus))
  1246. X                    calc-keypad-layout))
  1247. X  (let ((buffer-read-only nil)
  1248. X    (row calc-keypad-full-layout)
  1249. X    (y 0))
  1250. X    (erase-buffer)
  1251. X    (insert "\n")
  1252. X    (while row
  1253. X      (let ((col (car row)))
  1254. X    (while col
  1255. X      (let* ((key (car col))
  1256. X         (cwid (if (>= y 4)
  1257. X               5
  1258. X             (if (and (= y 3) (eq col (car row)))
  1259. X                 (progn (setq col (cdr col)) 9)
  1260. X               4)))
  1261. X         (name (if (and calc-standalone-flag
  1262. X                (eq (nth 1 key) 'calc-keypad-off))
  1263. X               "EXIT"
  1264. X             (if (> (length (car key)) cwid)
  1265. X                 (substring (car key) 0 cwid)
  1266. X               (car key))))
  1267. X         (wid (length name))
  1268. X         (pad (- cwid (/ wid 2))))
  1269. X        (insert (make-string (/ (- cwid wid) 2) 32)
  1270. X            name
  1271. X            (make-string (/ (- cwid wid -1) 2) 32)
  1272. X            (if (equal name "MENU")
  1273. X            (int-to-string (1+ calc-keypad-menu))
  1274. X              "|")))
  1275. X      (or (setq col (cdr col))
  1276. X          (insert "\n")))
  1277. X    (insert (if (>= y 4)
  1278. X            "-----+-----+-----+-----+-----"
  1279. X          (if (= y 3)
  1280. X              "-----+---+-+--+--+-+---++----"
  1281. X            "----+----+----+----+----+----"))
  1282. X        (if (= y 7) "+\n" "|\n"))
  1283. X    (setq y (1+ y)
  1284. X          row (cdr row)))))
  1285. X  (setq calc-keypad-prev-input t)
  1286. X  (calc-keypad-show-input)
  1287. X  (goto-char (point-min))
  1288. )
  1289. X
  1290. (defun calc-keypad-show-input ()
  1291. X  (or (equal calc-keypad-input calc-keypad-prev-input)
  1292. X      (let ((buffer-read-only nil))
  1293. X    (save-excursion
  1294. X      (goto-char (point-min))
  1295. X      (forward-line 1)
  1296. X      (delete-region (point-min) (point))
  1297. X      (if calc-keypad-input
  1298. X          (insert "Calc: " calc-keypad-input "\n")
  1299. X        (insert "----+-----Calc " calc-version "-----+----"
  1300. X            (int-to-string (1+ calc-keypad-menu))
  1301. X            "\n")))))
  1302. X  (setq calc-keypad-prev-input calc-keypad-input)
  1303. )
  1304. X
  1305. (defun calc-keypad-press ()
  1306. X  (interactive)
  1307. X  (or (eq major-mode 'calc-keypad)
  1308. X      (error "Must be in *Calc Keypad* buffer for this command"))
  1309. X  (let* ((row (save-excursion
  1310. X        (beginning-of-line)
  1311. X        (count-lines (point-min) (point))))
  1312. X     (y (/ row 2))
  1313. X     (x (/ (current-column) (if (>= y 4) 6 5)))
  1314. X     radix frac inv
  1315. X     (hyp (save-excursion
  1316. X        (set-buffer calc-main-buffer)
  1317. X        (setq radix calc-number-radix
  1318. X              frac calc-prefer-frac
  1319. X              inv calc-inverse-flag)
  1320. X        calc-hyperbolic-flag))
  1321. X     (invhyp t)
  1322. X     (menu (symbol-value (nth calc-keypad-menu calc-keypad-menus)))
  1323. X     (input calc-keypad-input)
  1324. X     (iexpon (and input
  1325. X              (or (string-match "\\*[0-9]+\\.\\^" input)
  1326. X              (and (<= radix 14) (string-match "e" input)))
  1327. X              (match-end 0)))
  1328. X     (key (nth x (nth y calc-keypad-full-layout)))
  1329. X     (cmd (or (nth (if inv (if hyp 4 2) (if hyp 3 99)) key)
  1330. X          (setq invhyp nil)
  1331. X          (nth 1 key)))
  1332. X     (isstring (and (consp cmd) (stringp (car cmd))))
  1333. X     (calc-is-keypad-press t))
  1334. X    (if invhyp (calc-wrapper))  ; clear Inv and Hyp flags
  1335. X    (unwind-protect
  1336. X    (cond ((or (null cmd)
  1337. X           (= (% row 2) 0))
  1338. X           (beep))
  1339. X          ((and (> (minibuffer-depth) 0))
  1340. X           (cond (isstring
  1341. X              (setq unread-command-char (aref (car cmd) 0)))
  1342. X             ((eq cmd 'calc-pop)
  1343. X              (setq unread-command-char ?\177))
  1344. X             ((eq cmd 'calc-enter)
  1345. X              (setq unread-command-char 13))
  1346. X             ((eq cmd 'calc-undo)
  1347. X              (setq unread-command-char 7))
  1348. X             (t
  1349. X              (beep))))
  1350. X          ((and input (string-match "STO\\|RCL" input))
  1351. X           (cond ((and isstring (string-match "[0-9]" (car cmd)))
  1352. X              (setq calc-keypad-input nil)
  1353. X              (let ((var (intern (concat "var-q" (car cmd)))))
  1354. X            (cond ((equal input "STO+") (calc-store-plus var))
  1355. X                  ((equal input "STO-") (calc-store-minus var))
  1356. X                  ((equal input "STO*") (calc-store-times var))
  1357. X                  ((equal input "STO/") (calc-store-div var))
  1358. X                  ((equal input "STO^") (calc-store-power var))
  1359. X                  ((equal input "STOn") (calc-store-neg 1 var))
  1360. X                  ((equal input "STO&") (calc-store-inv 1 var))
  1361. X                  ((equal input "STO") (calc-store-into var))
  1362. X                  (t (calc-recall var)))))
  1363. X             ((memq cmd '(calc-pop calc-undo))
  1364. X              (setq calc-keypad-input nil))
  1365. X             ((and (equal input "STO")
  1366. X               (setq frac (assq cmd '( ( calc-plus . "+" )
  1367. X                           ( calc-minus . "-" )
  1368. X                           ( calc-times . "*" )
  1369. X                           ( calc-divide . "/" )
  1370. X                           ( calc-power . "^")
  1371. X                           ( calc-change-sign . "n")
  1372. X                           ( calc-inv . "&") ))))
  1373. X              (setq calc-keypad-input (concat input (cdr frac))))
  1374. X             (t
  1375. X              (beep))))
  1376. X          (isstring
  1377. X           (setq cmd (car cmd))
  1378. X           (if (or (and (equal cmd ".")
  1379. X                input
  1380. X                (string-match "[.:e^]" input))
  1381. X               (and (equal cmd "e")
  1382. X                input
  1383. X                (or (and (<= radix 14) (string-match "e" input))
  1384. X                (string-match "\\^\\|[-.:]\\'" input)))
  1385. X               (and (not (equal cmd "."))
  1386. X                (let ((case-fold-search nil))
  1387. X                  (string-match cmd "0123456789ABCDEF"
  1388. X                        (if (string-match
  1389. X                         "[e^]" (or input ""))
  1390. X                        10 radix)))))
  1391. X           (beep)
  1392. X         (setq calc-keypad-input (concat
  1393. X                      (and (/= radix 10)
  1394. X                           (or (not input)
  1395. X                           (equal input "-"))
  1396. X                           (format "%d#" radix))
  1397. X                      (and (or (not input)
  1398. X                           (equal input "-"))
  1399. X                           (or (and (equal cmd "e") "1")
  1400. X                           (and (equal cmd ".")
  1401. X                            (if frac "1" "0"))))
  1402. X                      input
  1403. X                      (if (and (equal cmd ".") frac)
  1404. X                          ":"
  1405. X                        (if (and (equal cmd "e")
  1406. X                             (or (not input)
  1407. X                             (string-match
  1408. X                              "#" input))
  1409. X                             (> radix 14))
  1410. X                        (format "*%d.^" radix)
  1411. X                          cmd))))))
  1412. X          ((and (eq cmd 'calc-change-sign)
  1413. X            input)
  1414. X           (let* ((epos (or iexpon 0))
  1415. X              (suffix (substring input epos)))
  1416. X         (setq calc-keypad-input (concat
  1417. X                      (substring input 0 epos)
  1418. X                      (if (string-match "\\`-" suffix)
  1419. X                          (substring suffix 1)
  1420. X                        (concat "-" suffix))))))
  1421. X          ((and (eq cmd 'calc-pop)
  1422. X            input)
  1423. X           (if (equal input "")
  1424. X           (beep)
  1425. X         (setq calc-keypad-input (substring input 0
  1426. X                            (or (string-match
  1427. X                             "\\*[0-9]+\\.\\^\\'"
  1428. X                             input)
  1429. X                            -1)))))
  1430. X          ((and (eq cmd 'calc-undo)
  1431. X            input)
  1432. X           (setq calc-keypad-input nil))
  1433. X          (t
  1434. X           (if input
  1435. X           (let ((val (math-read-number input)))
  1436. X             (setq calc-keypad-input nil)
  1437. X             (if val
  1438. X             (calc-wrapper
  1439. X              (calc-push-list (list (calc-record
  1440. X                         (calc-normalize val)))))
  1441. X               (or (equal input "")
  1442. X               (beep))
  1443. X               (setq cmd nil))
  1444. X             (if (eq cmd 'calc-enter) (setq cmd nil))))
  1445. X           (setq prefix-arg current-prefix-arg)
  1446. X           (if cmd
  1447. X           (if (and (consp cmd) (eq (car cmd) 'progn))
  1448. X               (while (setq cmd (cdr cmd))
  1449. X             (if (integerp (car cmd))
  1450. X                 (setq prefix-arg (car cmd))
  1451. X               (command-execute (car cmd))))
  1452. X             (command-execute cmd)))))
  1453. X      (set-buffer calc-keypad-buffer)
  1454. X      (calc-keypad-show-input)))
  1455. )
  1456. X
  1457. (defun calc-keypad-x-left-click (arg)
  1458. X  "Handle a left-button mouse click in Calc Keypad window."
  1459. X  (let (coords)
  1460. X    (if (and calc-keypad-buffer
  1461. X         (buffer-name calc-keypad-buffer)
  1462. X         (get-buffer-window calc-keypad-buffer)
  1463. X         (setq coords (coordinates-in-window-p
  1464. X               arg (get-buffer-window calc-keypad-buffer))))
  1465. X    (let ((win (selected-window)))
  1466. X      (unwind-protect
  1467. X          (progn
  1468. X        (x-mouse-set-point arg)
  1469. X        (calc-keypad-press))
  1470. X        (and (window-point win)
  1471. X         (select-window win))))
  1472. X      (funcall calc-keypad-prev-x-left-click arg)))
  1473. )
  1474. X
  1475. (defun calc-keypad-x-right-click (arg)
  1476. X  "Handle a right-button mouse click in Calc Keypad window."
  1477. X  (if (and calc-keypad-buffer
  1478. X       (buffer-name calc-keypad-buffer)
  1479. X       (get-buffer-window calc-keypad-buffer)
  1480. X       (coordinates-in-window-p
  1481. X        arg (get-buffer-window calc-keypad-buffer)))
  1482. X      (save-excursion
  1483. X    (set-buffer calc-keypad-buffer)
  1484. X    (calc-keypad-menu))
  1485. X    (funcall calc-keypad-prev-x-right-click arg))
  1486. )
  1487. X
  1488. (defun calc-keypad-x-middle-click (arg)
  1489. X  "Handle a middle-button mouse click in Calc Keypad window."
  1490. X  (if (and calc-keypad-buffer
  1491. X       (buffer-name calc-keypad-buffer)
  1492. X       (get-buffer-window calc-keypad-buffer)
  1493. X       (coordinates-in-window-p
  1494. X        arg (get-buffer-window calc-keypad-buffer)))
  1495. X      (save-excursion
  1496. X    (set-buffer calc-keypad-buffer)
  1497. X    (calc-keypad-menu-back))
  1498. X    (funcall calc-keypad-prev-x-middle-click arg))
  1499. )
  1500. X
  1501. (defun calc-keypad-menu ()
  1502. X  (interactive)
  1503. X  (or (eq major-mode 'calc-keypad)
  1504. X      (error "Must be in *Calc Keypad* buffer for this command"))
  1505. X  (while (progn (setq calc-keypad-menu (% (1+ calc-keypad-menu)
  1506. X                      (length calc-keypad-menus)))
  1507. X        (not (symbol-value (nth calc-keypad-menu calc-keypad-menus)))))
  1508. X  (calc-keypad-redraw)
  1509. )
  1510. X
  1511. (defun calc-keypad-menu-back ()
  1512. X  (interactive)
  1513. X  (or (eq major-mode 'calc-keypad)
  1514. X      (error "Must be in *Calc Keypad* buffer for this command"))
  1515. X  (while (progn (setq calc-keypad-menu (% (1- (+ calc-keypad-menu
  1516. X                         (length calc-keypad-menus)))
  1517. X                      (length calc-keypad-menus)))
  1518. X        (not (symbol-value (nth calc-keypad-menu calc-keypad-menus)))))
  1519. X  (calc-keypad-redraw)
  1520. )
  1521. X
  1522. (defun calc-keypad-store ()
  1523. X  (interactive)
  1524. X  (setq calc-keypad-input "STO")
  1525. )
  1526. X
  1527. (defun calc-keypad-recall ()
  1528. X  (interactive)
  1529. X  (setq calc-keypad-input "RCL")
  1530. )
  1531. X
  1532. (defun calc-pack-interval (mode)
  1533. X  (interactive "p")
  1534. X  (if (or (< mode 0) (> mode 3))
  1535. X      (error "Open/close code should be in the range from 0 to 3."))
  1536. X  (calc-pack (- -6 mode))
  1537. )
  1538. X
  1539. (defun calc-keypad-execute ()
  1540. X  (interactive)
  1541. X  (let* ((prompt "Calc keystrokes: ")
  1542. X     (flush 'x-flush-mouse-queue)
  1543. X     (prefix nil)
  1544. X     keys cmd)
  1545. X    (save-excursion
  1546. X      (calc-select-buffer)
  1547. X      (while (progn
  1548. X           (setq keys (read-key-sequence prompt))
  1549. X           (setq cmd (key-binding keys))
  1550. X           (if (or (memq cmd '(calc-inverse
  1551. X                   calc-hyperbolic
  1552. X                   universal-argument
  1553. X                   digit-argument
  1554. X                   negative-argument))
  1555. X               (and prefix (string-match "\\`\e?[-0-9]\\'" keys)))
  1556. X           (progn
  1557. X             (setq last-command-char (aref keys (1- (length keys))))
  1558. X             (command-execute cmd)
  1559. X             (setq flush 'not-any-more
  1560. X               prefix t
  1561. X               prompt (concat prompt (key-description keys) " ")))
  1562. X         (eq cmd flush)))))  ; skip mouse-up event
  1563. X    (message "")
  1564. X    (if (commandp cmd)
  1565. X    (command-execute cmd)
  1566. X      (error "Not a Calc command: %s" (key-description keys))))
  1567. )
  1568. X
  1569. X
  1570. ;;; |----+----+----+----+----+----|
  1571. ;;; |  ENTER  |+/- |EEX |UNDO| <- |
  1572. ;;; |-----+---+-+--+--+-+---++----|
  1573. ;;; | INV |  7  |  8  |  9  |  /  |
  1574. ;;; |-----+-----+-----+-----+-----|
  1575. ;;; | HYP |  4  |  5  |  6  |  *  |
  1576. ;;; |-----+-----+-----+-----+-----|
  1577. ;;; |EXEC |  1  |  2  |  3  |  -  |
  1578. ;;; |-----+-----+-----+-----+-----|
  1579. ;;; | OFF |  0  |  .  | PI  |  +  |
  1580. ;;; |-----+-----+-----+-----+-----|
  1581. X
  1582. (defvar calc-keypad-layout
  1583. X  '( ( ( "ENTER" calc-enter calc-roll-down calc-roll-up calc-over )
  1584. X       ( "ENTER" calc-enter calc-roll-down calc-roll-up calc-over )
  1585. X       ( "+/-"     calc-change-sign calc-inv (progn -4 calc-pack) )
  1586. X       ( "EEX"     ("e") (progn calc-num-prefix calc-pack-interval)
  1587. X                 (progn -5 calc-pack)  )
  1588. X       ( "UNDO"     calc-undo calc-redo calc-last-args )
  1589. X       ( "<-"     calc-pop (progn 0 calc-pop)
  1590. X             (progn calc-num-prefix calc-pop) ) )
  1591. X     ( ( "INV"   calc-inverse )
  1592. X       ( "7"     ("7") calc-round )
  1593. X       ( "8"     ("8") (progn 2 calc-clean-num) )
  1594. X       ( "9"     ("9") calc-float )
  1595. X       ( "/"     calc-divide (progn calc-inverse calc-power) ) )
  1596. X     ( ( "HYP"   calc-hyperbolic )
  1597. X       ( "4"     ("4") calc-ln calc-log10 )
  1598. X       ( "5"     ("5") calc-exp calc-exp10 )
  1599. X       ( "6"     ("6") calc-abs )
  1600. X       ( "*"     calc-times calc-power ) )
  1601. X     ( ( "EXEC"     calc-keypad-execute )
  1602. X       ( "1"     ("1") calc-arcsin calc-sin )
  1603. X       ( "2"     ("2") calc-arccos calc-cos )
  1604. X       ( "3"     ("3") calc-arctan calc-tan )
  1605. X       ( "-"     calc-minus calc-conj ) )
  1606. X     ( ( "OFF"   calc-keypad-off )
  1607. X       ( "0"     ("0") calc-imaginary )
  1608. X       ( "."     (".") calc-precision )
  1609. X       ( "PI"     calc-pi )
  1610. X       ( "+"     calc-plus calc-sqrt ) ) )
  1611. )
  1612. X
  1613. (defvar calc-keypad-menus '( calc-keypad-math-menu
  1614. X                 calc-keypad-funcs-menu
  1615. X                 calc-keypad-binary-menu
  1616. X                 calc-keypad-vector-menu
  1617. X                 calc-keypad-modes-menu
  1618. X                 calc-keypad-user-menu ) )
  1619. X
  1620. ;;; |----+----+----+----+----+----|
  1621. ;;; |FLR |CEIL|RND |TRNC|CLN2|FLT |
  1622. ;;; |----+----+----+----+----+----|
  1623. ;;; | LN |EXP |    |ABS |IDIV|MOD |
  1624. ;;; |----+----+----+----+----+----|
  1625. ;;; |SIN |COS |TAN |SQRT|y^x |1/x |
  1626. X
  1627. (defvar calc-keypad-math-menu
  1628. X  '( ( ( "FLR"   calc-floor )
  1629. X       ( "CEIL"  calc-ceiling )
  1630. X       ( "RND"   calc-round )
  1631. X       ( "TRNC"  calc-trunc )
  1632. X       ( "CLN2"  (progn 2 calc-clean-num) )
  1633. X       ( "FLT"   calc-float ) )
  1634. X     ( ( "LN"    calc-ln )
  1635. X       ( "EXP"   calc-exp )
  1636. X       ( ""     nil )
  1637. X       ( "ABS"   calc-abs )
  1638. X       ( "IDIV"  calc-idiv )
  1639. X       ( "MOD"   calc-mod ) )
  1640. X     ( ( "SIN"   calc-sin )
  1641. X       ( "COS"   calc-cos )
  1642. X       ( "TAN"   calc-tan )
  1643. X       ( "SQRT"  calc-sqrt )
  1644. X       ( "y^x"   calc-power )
  1645. X       ( "1/x"   calc-inv ) ) )
  1646. )
  1647. X
  1648. ;;; |----+----+----+----+----+----|
  1649. ;;; |IGAM|BETA|IBET|ERF |BESJ|BESY|
  1650. ;;; |----+----+----+----+----+----|
  1651. ;;; |IMAG|CONJ| RE |ATN2|RAND|RAGN|
  1652. ;;; |----+----+----+----+----+----|
  1653. ;;; |GCD |FACT|DFCT|BNOM|PERM|NXTP|
  1654. X
  1655. (defvar calc-keypad-funcs-menu
  1656. X  '( ( ( "IGAM"  calc-inc-gamma )
  1657. X       ( "BETA"  calc-beta )
  1658. X       ( "IBET"  calc-inc-beta )
  1659. X       ( "ERF"   calc-erf )
  1660. X       ( "BESJ"  calc-bessel-J )
  1661. X       ( "BESY"  calc-bessel-Y ) )
  1662. X     ( ( "IMAG"  calc-imaginary )
  1663. X       ( "CONJ"  calc-conj )
  1664. X       ( "RE"     calc-re calc-im )
  1665. X       ( "ATN2"  calc-arctan2 )
  1666. X       ( "RAND"  calc-random )
  1667. X       ( "RAGN"  calc-random-again ) )
  1668. X     ( ( "GCD"   calc-gcd calc-lcm )
  1669. X       ( "FACT"  calc-factorial calc-gamma )
  1670. X       ( "DFCT"  calc-double-factorial )
  1671. X       ( "BNOM"  calc-choose )
  1672. X       ( "PERM"  calc-perm )
  1673. X       ( "NXTP"     calc-next-prime calc-prev-prime ) ) )
  1674. )
  1675. X
  1676. ;;; |----+----+----+----+----+----|
  1677. ;;; |AND | OR |XOR |NOT |LSH |RSH |
  1678. ;;; |----+----+----+----+----+----|
  1679. ;;; |DEC |HEX |OCT |BIN |WSIZ|ARSH|
  1680. ;;; |----+----+----+----+----+----|
  1681. ;;; | A  | B  | C  | D  | E  | F  |
  1682. X
  1683. (defvar calc-keypad-binary-menu
  1684. X  '( ( ( "AND"   calc-and calc-diff )
  1685. X       ( "OR"    calc-or )
  1686. X       ( "XOR"   calc-xor )
  1687. X       ( "NOT"   calc-not calc-clip )
  1688. X       ( "LSH"   calc-lshift-binary calc-rotate-binary )
  1689. X       ( "RSH"   calc-rshift-binary ) )
  1690. X     ( ( "DEC"   calc-decimal-radix )
  1691. X       ( "HEX"   calc-hex-radix )
  1692. X       ( "OCT"   calc-octal-radix )
  1693. X       ( "BIN"   calc-binary-radix )
  1694. X       ( "WSIZ"  (progn
  1695. X           (lambda (arg) (interactive "nWord size: ")
  1696. X             (setq prefix-arg arg))
  1697. SHAR_EOF
  1698. true || echo 'restore of calc-keypd.el failed'
  1699. fi
  1700. echo 'End of  part 18'
  1701. echo 'File calc-keypd.el is continued in part 19'
  1702. echo 19 > _shar_seq_.tmp
  1703. exit 0
  1704. exit 0 # Just in case...
  1705. -- 
  1706. Kent Landfield                   INTERNET: kent@sparky.IMD.Sterling.COM
  1707. Sterling Software, IMD           UUCP:     uunet!sparky!kent
  1708. Phone:    (402) 291-8300         FAX:      (402) 291-4362
  1709. Please send comp.sources.misc-related mail to kent@uunet.uu.net.
  1710.